      ! XX   
      ! LEE SERGEY
      ! 2103/1 (gruppa)
      ! 25.09.12     
 	  
      Program F2012_3                               
      Implicit NONE

        INTEGER P,M,I,J,L,O,Q,OP
	  DOUBLE PRECISION X(45),DET,D,WER
	  DOUBLE PRECISION V(45,45),N(45,45),B(45),H(45),W,T
	  COMMON W,T

        PRINT *, 'XX'                
        PRINT *, 'LEE SERGEY'        
        PRINT *, '2103/1'                            
        PRINT *, '25.09.12'        
        PRINT *        
         
        DO Q=3,12
	  P=4
	  M=P
	  O=P
	  

	     
	  DO I=1,P
	    IF(Q>9)THEN
		  WER=10**9
		  DO OP=1,Q-9
		    WER=WER*10
	      END DO
		  ELSE
		    WER=10**Q
		END IF                     
	    V(I,I)=1+WER
	  END DO
	  DO I=1,P-1
	    DO J=1,M-I
	      V(J,J+I)=1
          END DO
	  END DO
	  DO I=1,P-1
	    DO J=1,M-I
	      V(J+I,J)=-1-WER
	    END DO
        END DO
	  DO I=1,P-1
	    B(I)=-1
	  END DO
	  B(P)=1+WER
	  DO I=1,P
	    DO J=1,P
	      N(I,J)=WER
	    END DO
          H(I)=1
        END DO
	  H(P)=WER        
	  IF(Q==3)THEN
	    D=DET(M,Q)
	    DO I=2,M*Q
	      D=D/10
          END DO
	    D=D/10
	    IF(D==0)THEN
	      M=0
	      N=0
		  O=0
	      PRINT*,'DETERMINANT IS ZERO'
          END IF
        END IF

        DO L=1,O-1
	    DO I=L+1,P                                   
	      V(I,L)=V(I,L)*N(L,L)  
		  N(I,L)=N(I,L)*V(L,L)
	      W=V(I,L)
	      T=N(I,L)
		  CALL OUT_Arr(W,T)
            V(I,L)=W
	      N(I,L)=T		                   
          END DO                         

	    B(L)=B(L)*N(L,L)
	    H(L)=H(L)*V(L,L)
	    W=B(L)
	    T=H(L)
	    CALL OUT_Arr(W,T)
	    B(L)=W
	    H(L)=T	



	    DO I=L+1,P                                                       
	      DO J=L+1,M                                                 
	        V(J,I)=V(J,I)*N(L,I)*N(J,L)-V(L,I)*V(J,L)*N(J,I)
			N(J,I)=N(J,I)*N(L,I)*N(J,L)
			W=V(J,I)
	        T=N(J,I)
		    CALL OUT_Arr(W,T)
              V(J,I)=W
	        N(J,I)=T	              
	      END DO                                                       
	      B(I)=B(I)*H(L)*N(L,I)-B(L)*V(L,I)*H(I)
	      H(I)=H(I)*H(L)*N(L,I)
	      W=B(I)
	      T=H(I)
	      CALL OUT_Arr(W,T)
	      B(I)=W
	      H(I)=T	

		    
            V(L,I)=0
		  N(L,I)=1                                                  
	    END DO                                                      
	    V(L,L)=1
		N(L,L)=1                                                   
	  END DO

	

	  X(P)=B(P)*N(P,P)/H(P)/V(P,P)


	  DO I=P-1,1,-1
	    L=P                                  
	    O=I
	    DO WHILE((P-O)>0)
	      B(I)=B(I)*N(L,I)-V(L,I)*H(I)*X(L)
	      H(I)=H(I)*N(L,I)	      
	      X(I)=B(I)/H(I)
	      L=L-1
		  O=O+1	
           END DO
     	  END DO
        DO I=1,M
	    IF(X(I)>0.8)THEN
	      X(I)=1-X(I)
          END IF
	    OPEN(6,FILE='output.txt')                     ! gruppa
          WRITE(6,*) X(I)
	    PRINT*,X(I)
	  END DO	  
	                                 
      
        END DO
        END                                            

******************************
	SUBROUTINE  Out_Arr(W,T)         
      IMPLICIT NONE  
	  
	  DOUBLE PRECISION R,P,W,T,U
	  INTEGER*8 I
	  

 

	
        IF(W>T)THEN
	    P=T
	    R=W
	  ELSE                      
	    P=W
	    R=T
	  END IF

        DO WHILE((MOD(P,2.0).EQ.0).AND.(MOD(R,2.0).EQ.0))
	    P=P/2
	    R=R/2	    
	  END DO
        DO WHILE((MOD(P,3.0).EQ.0).AND.(MOD(R,3.0).EQ.0))
	    P=P/3
	    R=R/3
	  END DO
	  DO WHILE((MOD(P,5.0).EQ.0).AND.(MOD(R,5.0).EQ.0))
	    P=P/5
	    R=R/5
	  END DO
	  DO WHILE((MOD(P,7.0).EQ.0).AND.(MOD(R,7.0).EQ.0))
	    P=P/7.0
	    R=R/7.0
	  END DO


	  IF(P==R)THEN
	    P=1
	  	R=1
	  ELSE
	    IF(R/2>3000000)THEN
	      U=3000000
	    ELSE
	      U=R/2
	    END IF
	    DO I=11,U,2	

	      IF(MOD(R,DBLE(I)).EQ.0)THEN
	        IF(MOD(P,DBLE(I)).EQ.0)THEN
	          DO WHILE((MOD(P,DBLE(I)).EQ.0).AND.(MOD(R,DBLE(I)).EQ.0))
	            R=R/DBLE(I)
			    P=P/DBLE(I)
			  END DO
		    END IF
		  END IF		
	  	END DO   
        END IF
         
	  
	  IF(W>T)THEN
	    W=R
	    T=P
	  ELSE                    
	    W=P
	    T=R
	  END IF

      RETURN                  
      END 



      RECURSIVE FUNCTION DET (N,C) RESULT(D)
      INTEGER M,N,I,B,Q,E,A,V(40,2),L,C
	DOUBLE PRECISION F(5,5),D
      COMMON B,M,E,Q,V,L

       
	  IF(L==0)THEN
	    M=N
	    L=L+1
	  END IF
 	
	  D=0
	
        DO I=1,M                                 
	    F(I,I)=1+10**C
	  END DO
	  DO I=1,M-1
	    DO J=1,M-I
	      F(J,J+I)=1
          END DO
	  END DO
	  DO I=1,M-1
	    DO J=1,M-I
	      F(J+I,J)=-1-10**C
	    END DO
        END DO

	  DO A=1,M-3
          E=V(A,1)
	    Q=V(A,2)
	    DO I=E,1,-1
	      DO J=Q,M
	        F(I+Q-1,J)=F(I+Q-2,J)
	      END DO
	    END DO
        END DO
 	  
	  IF(N>2)THEN
   	    DO I=M-N+1,M
	      B=I
            IF(N>3)THEN
	        V(M-N+1,1)=I-M+N-1
	        V(M-N+1,2)=M-N+2
            END IF 
		  D=D+DET(N-1,C)*F(I,M-N+1)*(-1)**(M-N+1+I)
          END DO
   	  ELSE
    	    IF(B==M-2)THEN
	      D=F(M-1,M-1)*F(M,M)-F(M,M-1)*F(M-1,M)
          END IF
	    IF(B==M-1)THEN
	      D=F(M-2,M-1)*F(M,M)-F(M,M-1)*F(M-2,M)
          END IF
	    IF(B==M)THEN
	      D=F(M-2,M-1)*F(M-1,M)-F(M-1,M-1)*F(M-2,M)
          END IF
   	  END IF

      END
       


       